(** Automatic building of Gtk interface from the histogram hierarchy *)

module GT = Gtk_tools
module K = GdkKeysyms
open Gtk_helpers
open Gtk_basic_window.Inc

let init_area_size = (600, 500) (* pixels *)

(** basic_window successor: it implements drawing through plplot *)   
class drawable_histo_window ?(is_main_window=true) window_title =
object(self)
    inherit Gtk_basic_window.window ~interactive:true ~is_main_window window_title

    val mutable area_size = init_area_size
    val area = 
        let area = GMisc.drawing_area () in
        let width, height = init_area_size in
        area#misc#set_size_request ~width:600 ~height:500 ();
        area

    initializer 
	main_vbox#pack ~expand:true ~fill:true paned_window#coerce;
	paned_window#add2 area#coerce

  method draw_current_hist_real ~show_errors ~printing ~plot_init ~plot_end =
    ignore(
(*      Gtk_pldraw.draw_on_event 
        (* ~size:area_size  --- demand big size!? *) 
        ~plot_init area 
	(fun () ->
        *)
           self#make_configure;
           let plot ix iy = 
(*             let ho = List.rev hists_options.(ix).(iy) and
                 sec_hists = List.rev hist_fits.(ix).(iy) in*)
           let hists = hists_options.(ix).(iy).dhlist in
	   let opt = hists_options.(ix).(iy).show_opt_l in
	   let sec_hists = hist_fits.(ix).(iy).dhlist in
	   let sec_opt = hist_fits.(ix).(iy).show_opt_l in
             Pldraw.advance (ix,iy) self#nx_ny;
             Pldraw.draw_hist hists 
             ~plot_opt:hists_options.(ix).(iy).plot_opt ~opt
             ~sec_hists ~sec_opt
(*:(List.map (fun _ -> 
                 {Histo.standard_plot with Histo.plot1d=Histo.Polyline}
             ) sec_hists);*)
	   in
           let there_was_error=ref false and last_error = ref "" in
           let nx, ny = self#nx_ny in
           for iy=0 to ny-1 do
               for ix=0 to nx-1 do
                   try plot ix iy 
		    with Histo.Invalid_histogram error -> (
                      there_was_error := true;
                      last_error := error;
		      print_endline ("Error:\n"^error)
                    )
               done
           done;
           printing ();
           plot_end ();
           self#make_expose_all;
           if show_errors && !there_was_error then
               self#complain ~message:("Error:\n" ^ !last_error)
                   ~from:(area#coerce) (); 
	)
    
    (*new *)
    method init_plotting = ignore (Gtk_pldraw.draw_on_event 
        (* ~size:area_size  --- demand big size!? *) 
        ~plot_init:(fun () -> 
            if is_main_window then (Pldraw.init self#nx_ny))
         area (fun () -> true))

    method reinit_plotting =
        if is_main_window then (
        Pldraw.end_draw();
        self#init_plotting
        )

(*    initializer self#init_plotting*)

    method draw_current_hist ?(show_errors=true) () =
        self#draw_current_hist_real ~show_errors ~printing:(fun () -> ()) 
        ~plot_init:(fun () -> ())
        ~plot_end:(fun () -> ())
(*	  ~plot_init:(fun () -> Pldraw.init self#nx_ny)
	  ~plot_end:(fun () -> Pldraw.end_draw ())
*)

    method save ?color file_name =
        Printf.printf "saving to %s\n" file_name;
        self#draw_current_hist_real
	  ~plot_init:(fun () -> Pldraw.init_for_printing ?color self#nx_ny)
(*          ~plot_end:Pldraw.end_draw*)
          ~plot_end:(fun () -> ())
          ~show_errors:false
	  ~printing:(
	  fun () ->
	    try Pldraw.save_plot file_name
            with Pldraw.Unknown_file_type t -> 
                self#complain ~message:("Unknown file type '"^t^"'") ()
        );
        flush stdout

    val mutable pixmap = Gdk.Pixmap.create ~height:1 ~width:1 ~depth:1 () 
    initializer pixmap <- (
        let win = GWindow.window (*~resizable:true ~show:false*) () in
        win#show (); win#misc#hide();
        Gtk_pldraw.make_pixmap win#as_widget
    )
    method make_configure =
        pixmap <- Gtk_pldraw.ev_plotwindow_configure area#as_widget pixmap
    method make_expose e =
        ignore(Gtk_pldraw.ev_plotwindow_expose area#as_widget pixmap e)
    method make_expose_all =
        ignore(Gtk_pldraw.ev_plotwindow_expose_all area#as_widget pixmap)
(*    val mutable for_area = ()
    initializer for_area <- ( *)
    initializer
        area#event#connect#configure ~callback:(fun e -> 
(*            print_endline "configure event";*)
            self#reinit_plotting;
(*            let rect = GdkEvent.Expose.area e in
            let width = Gdk.Rectangle.width rect and height =
                Gdk.Rectangle.height rect in*)
            let width = GdkEvent.Configure.width e and
            height = GdkEvent.Configure.height e in
            Printf.printf "w=%i h=%i\n" width height; flush stdout;
            area_size <- (width, height);
           (* self#make_configure;*)
            self#draw_current_hist ~show_errors:false ();
            true);
        area#event#connect#expose ~callback:(fun e -> 
            (*new *)
(*            print_endline "expose event";*)
            self#make_expose e;
            true);
(*        area#event#connect#motion_notify ~callback:(fun ev ->
            Printf.printf "x=%f y=%f\n" 
                (GdkEvent.Motion.x ev)
                (GdkEvent.Motion.y ev);
                flush stdout;
                true
        );*)
        area#event#add [`POINTER_MOTION; `POINTER_MOTION_HINT];
        area#event#connect#motion_notify 
                ~callback:(self#proc_ev_motion_notify);
        ()
    val slice_window = lazy (
        new drawable_histo_window ~is_main_window:false 
                "show slices, projections" 
    )
    method slice_window = Lazy.force slice_window

    val mutable proc_ev_motion_notify = None

    method hide_spw = 
        proc_ev_motion_notify <- None;
(*        self#slice_window#main_window#misc#hide ();*)
        ignore (area#event#connect#motion_notify ~callback:(fun _ -> true))
    method show_spw = 
        self#slice_window#main_window_show ();
(*        ignore (self#slice_window#main_window#connect#destroy 
                ~callback:(fun () -> 
                    print_endline "slice window hidden";
                    self#hide_spw));*)
(*        self#slice_window#make_configure;
        self#slice_window#show ();*)
(*        self#slice_window#main_window#show ();*)
(*        self#slice_window#make_configure;*)
(*
    method get_hist_on_page  =
        let nx, ny = self#nx_ny in
        let iy = n / nx and ix = n mod nx in
        let l = List.length hists_options.(ix).(iy).dhlist in
        if n<0 || n > nx*ny-1 || 
                List.length hists_options.(ix).(iy).dhlist = 0 then (
            let message = Printf.sprintf 
            "unknown h. on page n=%i (from %i,%i -> %i,%i length=%i)"
            n nx ny ix iy (List.length hists_options.(ix).(iy).dhlist) in
            self#complain ~message ();
            Histo.dummy_hist ()
        )
        else List.hd hists_options.(ix).(iy).dhlist
*)

    method set_slice_hist ~n ~proj (ix,iy) (wx,wy) =
        if List.length hists_options.(ix).(iy).dhlist = 0 
        then self#slice_window#add_list []
        else (
            let hist = List.hd hists_options.(ix).(iy).dhlist in
            ( match hist with 
              | Histo.H1d _ -> self#slice_window#add_list []
              | Histo.H2d h ->
                   let coord = ( match proj with 
                        Histo.X -> wx | Histo.Y -> wy ) in 
                   let bin = Histo.H2.bin_of proj h coord in
                   let bin1 = bin - n/2 in
                   let bin2 = bin1 + n - 1 in
                   let p1 = Histo.H2.c_of_bin h proj bin1 and 
                   p2 = Histo.H2.c_of_bin h proj bin2 in
                   let slice_info = Some (proj, p1, p2) in
                   if slice_info = hists_options.(ix).(iy).slice_info 
                   then ()
                   else (
                       let l = List.map2 (fun h show_opt -> 
                           let h' = Histo.get_2d h in
                           (Gtk_basic_window.H.H1d (
                               Process_slices.get_slice_projection 
                               ~proj h' (p1,p2)
                           )), show_opt
                       ) hists_options.(ix).(iy).dhlist 
                         hists_options.(ix).(iy).show_opt_l in
                       self#slice_window#add_list_options
                               ~plot_opt:Histo.standard_plot l;
                       hists_options.(ix).(iy).slice_info <- slice_info
                   )
            )
        )

    method get_coordinate (dev_x,dev_y) =
(*        let wx,wy,n = Plplot.plcalc_world (1.-.dev_x) dev_y in*)
        let wx,wy,n = Plplot.plcalc_world dev_x (1.-.dev_y) in

      (*  let wy,wx,n = Plplot.plcalc_world (1.-.dev_y) dev_x in*)
(*        let wx,wy,n = Plplot.plcalc_world dev_x (1.-.dev_y) in*)
        Printf.printf "dev_x=%f dev_y=%f => x=%f y=%f \n" 
                dev_x dev_y wx wy; flush stdout;
        if n < 0
        then None
        else (
            let nx, ny = self#nx_ny in
            let dx = 1. /. float nx and dy = 1. /. float ny in
            let ix = int_of_float (dev_x /. dx) and
            iy = int_of_float (dev_y /. dy) in
            Some (wx,wy,ix,iy)
        )

    method proc_ev_motion_notify ev =
        ( match proc_ev_motion_notify with
          | None -> true
          | Some (n,proj) ->
            let ax, ay = area_size in
            let dev_x = GdkEvent.Motion.x ev /. (float ax) in
            let dev_y = GdkEvent.Motion.y ev /. (float ay) in
            ( match self#get_coordinate (dev_x,dev_y) with
              | Some (wx,wy,ix,iy) ->
                      self#set_slice_hist ~n ~proj (ix,iy) (wx,wy);
                      self#ia
              | None -> print_endline "<none>"
            );
            true
        )

    method start_see_slices n proj =
        self#show_spw;
        self#ia;
        proc_ev_motion_notify <- Some (n,proj);
        ()
(*
    initializer
       vbox_controls#pack (
           GT.button "see slices" [`Pressed (fun () -> 
               self#start_see_slices)]
       )
*)
end

module Gtk_dir (F: Histo_dir.Histogram_supplement) =
struct
  module HD = Histo_dir.Make(F)
  type histo_container = [
     `Widget of string * GObj.widget 
    | `Widget_dir of string * GObj.widget * 
        (histo_container Directory.directory)
    | HD.histo_container
  ]
  let name_of = ( function 
      | `Widget (name,_) -> "widget "^name
      | `Widget_dir (name,_,_) -> "widget dir. "^name
      | #HD.histo_container as c -> HD.container_name c
  )
  module Elt = struct
      type t = histo_container
      let name_of = name_of
  end
  include Directory.Find_print_make(Elt)
  let rec clear dir = Directory.iter_files dir 
      ~f:(function
          | #HD.histo_container as hc -> HD.clear_container hc
          | `Widget_dir (_,_,dir) -> clear dir
          | `Widget (_,_) -> ()
  )

  let parse_command str =
    (try 
      let n = Str.search_forward (Str.regexp "\\$") str 0 in
      let path = String.sub str 0 n in
      let cmd = String.sub str (n+1) (String.length str - n - 1) in
      path, cmd
     with Not_found -> str, "")
  ;;

  let rec find str dir = 
      let path, cmd = parse_command str in
      get_content' cmd (find_file ~path dir)
  and get_content' cmd = (function
      | #HD.histo_container as c -> HD.get_content cmd c
      | `Widget_dir (_,_,dir) -> find cmd dir
      | `Widget (_,_) -> failwith "no histograms in widget"
  )
end

module Make_histogram_hierarchy
        (F: Histo_dir.Histogram_supplement) =
struct
  include Gtk_dir(F)
  class virtual histo_dir_window window_title =
  object(self)
      inherit drawable_histo_window window_title
      method start =
          self#main_window_show ();
          Thread.create GtkThread.main ()
      method construct ?(skip_wdd=false) ?(level=0) hist_directory = 
(*          self#make_finder vbox_controls#pack hist_directory;*)
          let set_text, w =self#make_finder hist_directory in
          vbox_controls#pack w;
          vbox_controls#pack ~expand:true ~fill:true
          (snd (self#make_dir_struct ~skip_wdd hist_directory level "" set_text));
          vbox_controls 
  
(*      method nb_append (notebook:GPack.notebook) label x=
          ignore(notebook#append_page ~tab_label:label#coerce x)*)
  (*    method nb_insert (notebook:GPack.notebook) label x=
          ignore(notebook#insert_page ~tab_label:label#coerce x)*)
  
(*      val entry_path = GEdit.entry ()*)
  
      method make_finder hist_directory =
          let entry_path = GEdit.entry () in
          let activate text = (
              self#add_list (
                  try [F.hist (find entry_path#text hist_directory)]
                  with Directory.Find_error reason -> (
                      self#complain ~message:reason ~from:entry_path#coerce ();
                      []);
              )
          ) in
          entry_path#connect#activate ~callback:(fun () -> activate
          entry_path#text);
          let w = GT.hbox [`Expand_all; `Fill_all] [
              GT.button "list" [`Pressed ( fun () -> print hist_directory)];
(*              GT.entry "" [`Activate activate];*)
              entry_path#coerce;
          ] in
          entry_path#set_text, w
(*
          let hbox=GPack.hbox ~packing:pack () in
          let button = GButton.button ~label:"List" ~packing:hbox#pack () in
          button#connect#clicked ~callback:( fun () ->
              print hist_directory;
          );
          hbox#pack entry_path#coerce;
          entry_path#set_text "";
          entry_path#connect#activate ~callback:(fun () ->
              self#add_list (
                  try [F.hist (find_file entry_path#text hist_directory)]
                  with Directory.Find_error reason -> (
                      self#complain ~message:reason ~from:entry_path#coerce ();
                      []);
              )
          );
          ()
*)
      method create_new_notebook level envelope=
          GPack.notebook ~tab_pos:(if level < 3 then `TOP else`LEFT) 
             ~scrollable:true ~packing:envelope ()
  
      method virtual make_button_for_hist:
          F.t -> string -> (string -> unit) -> GObj.widget 
(*          F.t -> string -> (GObj.widget -> unit) -> unit*)
 
      method make_frame_of_hists hl path set_text =
          GT.scrollable [] (
              GT.vbox [] (
                  List.map (fun h ->
                  self#make_button_for_hist h path set_text)
                  hl
              )
          ) 
(*
      method make_frame_of_hists hl name path env=
  	let scrolled_window = GBin.scrolled_window ~border_width:4
  	~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC 
  	~packing:env ()
  	in
          scrolled_window#misc#set_size_request ~width:100 ~height:200 ();
          let vbox=GPack.vbox ~packing:scrolled_window#add_with_viewport () in 
          List.iter (fun h -> self#make_button_for_hist h path vbox#pack
          ) hl
*)  
      (** this function goes through ierarchical structure of histograms thus
          building appropriate GUI *)

      method make_dir_struct ?skip_wdd (hist_dir : t) level current_path set_text :
          string*GObj.widget =
          ( match hist_dir with
              | Directory.Directory (txt, contents) ->
                 txt, GT.notebook 
                 [`Tab_pos (if level < 3 then `TOP else `LEFT)]
                 (List.map (fun c -> 
                     self#make_dir_struct c (level+1) 
                     (current_path^"/"^txt) set_text
                 ) contents)
              | Directory.File file ->
                 self#make_dir_element ?skip_wdd current_path file set_text
          )
      method make_dir_element ?(skip_wdd=false) current_path file set_text = 
        let path str = current_path^"/"^str in
        (match file with
          | `Empty -> "-", GT.label "-" []
          | `Group grp -> 
                let elt_lst = List.map (fun obj -> 
                        (obj :> histo_container)) grp#get_hists in
                self#make_dir_struct 
                (Directory.of_files grp#name elt_lst) 3 "" set_text
                          (*grp#name, 
                                self#make_frame_of_hists 
                        grp#get_hists (path grp#name) set_text*)

          | `Elt hf -> let h = F.hist hf in let name = Histo.name h in
                name, 
                self#make_frame_of_hists [hf] (path name) set_text
          | `Hist_list (name,list) -> name, 
                self#make_frame_of_hists list (path name) set_text
          | `Array_picture (nx,name,arr) ->
              name, GT.scrollable [] (
                let table = GPack.table ~rows:1 ~columns:nx () in
                for ix = 0 to nx-1 do
                    table#attach ~left:0 ~top:ix ~expand:`BOTH (
                        self#make_button_for_hist arr.(ix) 
                        (path name) set_text)
                done;
                table#coerce
              )
          | `Matrix_picture (nx,ny,name,arr) ->
              name, GT.scrollable [] (
                let table = GPack.table ~rows:nx ~columns:ny () in
                for ix = 0 to nx-1 do
                    for iy = 0 to ny-1 do
                        table#attach ~left:ix ~top:(ny-1-iy) ~expand:`BOTH
                        (self#make_button_for_hist arr.(ix).(iy) 
                        (path name) set_text)
                    done
                done;
                table#coerce
              )
          | `Opt_matrix_picture (nx,ny,name,arr) ->
              name, GT.scrollable [] (
                let table = GPack.table ~rows:nx ~columns:ny () in
                for ix = 0 to nx-1 do
                    for iy = 0 to ny-1 do
                        match arr.(ix).(iy) with
                        Some h ->
                        table#attach ~left:ix ~top:(ny-1-iy) ~expand:`BOTH
                        (self#make_button_for_hist h
                        (path name) set_text)
                        | None -> ()
                    done
                done;
                table#coerce
              )
          | `Widget (name,widget) ->
              name, widget
          | `Widget_dir (name,widget,dir) ->
                let paned = GPack.paned `VERTICAL () in
                paned#add1 widget;
                let set_text, w =self#make_finder dir in
                let vbox = GPack.vbox () in
                vbox#pack w;
                if not skip_wdd then (
                    vbox#pack ~expand:true ~fill:true 
                        (snd (self#make_dir_struct dir 3 "" set_text));
                );
                paned#add2 vbox#coerce;
                name, paned#coerce
      )

(*
      method make_dir_struct (hist_dir : t) level current_path
      (envelope: GMisc.label -> GObj.widget -> unit) =
        let show_hist_list list group_name =
          self#make_frame_of_hists list group_name 
            (current_path^group_name^"/")
            (envelope (GMisc.label ~text:group_name ()))
        in
          match hist_dir with
              `Group grp -> show_hist_list grp#get_hists grp#name
  	  | `Hist_list (name,list) -> show_hist_list list name
  	  | `Array_picture (nx,name,arr) ->
                let scrolled_window = GBin.scrolled_window ~border_width:10
                    ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC 
                    ~packing:(envelope (GMisc.label ~text:name ())) ()
                in
                let table = GPack.table ~rows:1 ~columns:nx
                    ~packing:scrolled_window#add_with_viewport () in
                for ix = 0 to nx-1 do
                    self#make_button_for_hist arr.(ix) 
                    (current_path^name^"/")
                    (table#attach ~left:0 ~top:ix ~expand:`BOTH)
                done
  	  | `Matrix_picture (nx,ny,name,arr) ->
                let scrolled_window = GBin.scrolled_window ~border_width:10
                    ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC 
                    ~packing:(envelope (GMisc.label ~text:name ())) ()
                in
                let table = GPack.table ~rows:nx ~columns:ny 
                    ~packing:scrolled_window#add_with_viewport () in
                for ix = 0 to nx-1 do
                    for iy = 0 to ny-1 do
                        self#make_button_for_hist arr.(ix).(iy) 
                        (current_path^name^"/")
                        (table#attach ~left:ix ~top:(ny-1-iy) ~expand:`BOTH)
                    done
                done
          | `Empty -> ()
        | `Widget (name,widget) ->
                let vbox=GPack.hbox 
                  ~packing:(envelope (GMisc.label ~text:name ())) () in
                vbox#pack widget
        | `Widget_dir (name,widget,dir) ->
                let vbox=GPack.vbox 
                  ~packing:(envelope (GMisc.label ~text:name ())) () in
(*                let pack  w = vbox#pack (*~fill:true*) ~expand:true w in*)
                vbox#pack widget;
                self#make_dir_struct dir 3 (current_path^name^"/")
                        (fun _ w -> vbox#pack ~expand:true w)
        | `Directory (name,hlist) -> 
                let nb=self#create_new_notebook level
                          (envelope (GMisc.label ~text:name ())) in
  (*              let vbox=GPack.vbox ~packing:
                          (self#nb_append nb (GMisc.label ~text:"все" ())) () in
                let vbox_pack label w = vbox#pack w in*)
                List.iter 
                          (fun dir_content -> self#make_dir_struct
                          dir_content (level+1) (current_path^name^"/")
                           (* vbox_pack*) (self#nb_append nb) ) hlist
*)                           
  end 
end

module Simple =
struct
  module Basic = Make_histogram_hierarchy(Histo_dir.Just_histogram)
  let directory = Basic.make

  class histo_dir_window window_title =
    object(self)
      inherit Basic.histo_dir_window window_title

      method make_button_for_hist h path set_text =
          let f () = (
                  self#add h;
                  set_text (path^"$"^(Histo.name h))
          ) in
          GT.button (Histo.name h) [`Pressed f]
        (*  let button = GButton.button ~label:(Histo.name h) ~packing:e_hist () in
          ignore(button#connect#clicked ~callback:(fun () -> 
              ))*)
    end
end

type p = Histo.projection
exception Incorrect_combination of string
(*        type t *)
(*          type f_get = F1 of t -> float | F2 of (t -> float * float) *)
(*        val fill_by: (f: t) -> Histo.hist -> unit*)
module Extendable_with ( Hit:
    sig
        type get_values
        val not_graph: get_values -> bool
        val combine: 
            p1:p -> get_values -> p2:p -> get_values 
                -> get_values
        val create:  Histo.info -> get_values -> a_x:Histo.Axis.t -> a_y:Histo.Axis.t -> Histo.hist
    end
) =
struct
  module Histogram_supplement =
      Histo_dir.Func_histogram ( struct type func = Hit.get_values end)
(*      struct
          type t = Histo.hist * Hit.get_values
          let hist (h,_) = h
          let f (_,f) = f
      end*)
  module Basic = Make_histogram_hierarchy(Histogram_supplement)
  open Gobject.Data
  class histo_dir_window window_title =
    let bindings_button, bindings_window = button_popup_window "binding list" in
    let columns = new GTree.column_list in
    let id_column = columns#add string and
    path_column = columns#add string in
    object(self)
      inherit Basic.histo_dir_window window_title
      initializer vbox_controls#pack bindings_button#coerce

      val mutable f_list : (string * (Histo.hist * Hit.get_values)) list = []

      val gtk_tree_model = (
          let store = GTree.list_store columns in
          let view = GTree.view ~model:store ~packing:bindings_window#add () in
          let col = GTree.view_column ~title:"id"
                ~renderer:(GTree.cell_renderer_text [], ["text", id_column]) ()
          in
          ignore (view#append_column col);
          let col = GTree.view_column ~title:"path"
             ~renderer:(GTree.cell_renderer_text [], ["text", path_column]) ()
          in
          ignore (view#append_column col);
          store
      )

      method add_binding text hf path =
          if List.exists (fun (s,_) -> text = s) f_list
          then (self#complain ~message:("binding "^text^" exists") ())
          else (
              f_list <- (text, hf) :: f_list;
              let iter = gtk_tree_model#append () in
              gtk_tree_model#set ~row:iter ~column:id_column text;
              gtk_tree_model#set ~row:iter ~column:path_column path
          )

      method make_button_for_hist hs path set_text =
          let h = Histogram_supplement.hist hs in
          let full_path = path^"$"^(Histo.name h) in

          let hbox = GPack.hbox () in
          let button = GButton.button ~label:(Histo.name h) 
                ~packing:hbox#pack () in
          ignore(button#connect#clicked ~callback:(fun () -> 
                  self#add h;
                  set_text full_path
          ));
          let f = Histogram_supplement.f hs in
          if Hit.not_graph f then (
              let entry = GEdit.entry ~packing:hbox#pack () in
              entry#misc#set_size_request ~width:40 ~height:20 ();
              ignore(entry#connect#activate ~callback:(fun () ->
                  self#add_binding entry#text (h,f) full_path
              ))
          );
          hbox#coerce

      method new_hist_chooser =
          let hbox = GPack.hbox ~packing:vbox_controls#pack () in
          let label text = GMisc.label ~text ~packing:hbox#pack () in
          let entry text width = 
              let e = GEdit.entry ~text ~packing:hbox#pack () in
              e#misc#set_size_request ~width ~height:20 ();
              e
          in
          let _ = label "2d dep. (oY)" in
          let e_y = entry "" 40 in
          let e_p_y = entry "X" 20 in
          let _ = label "of (oX)" in
          let e_x = entry "" 40 in
          let e_p_x = entry "X" 20 in
          let get_proj p = Histo.parse_projection p#text in
	  let _ = label "nY" in
	  let d_y = entry "50" 30 in
	  let _ = label "nX" in
	  let d_x = entry "50" 30 in
	  let dim d = int_of_string d#text in
	  let make_axis h p d = 
              Histo.Axis.subst_n (Histo.get_axis h p) (dim d) in
          let activate e = ignore(e#connect#activate ~callback:(fun () ->
              let h_y,f_y = List.assoc e_y#text f_list 
              and h_x,f_x = List.assoc e_x#text f_list in
	      let p_y = get_proj e_p_y and p_x = get_proj e_p_x in
              let a_y = make_axis h_y p_y d_y 
              and a_x = make_axis h_x p_x d_x in
              let f = Hit.combine ~p1:p_x f_x ~p2:p_y f_y in
              let title = e_y#text^":"^e_x#text in
              let h = Hit.create ~a_x ~a_y 
                  {Histo.name=title; Histo.title=title} f in
              self#add h
          )) in
	    activate e_x; activate e_y

      initializer self#new_hist_chooser
    end
end

(*
let init new_object lock =
    let window = GWindow.window ~title:"Монитор <<ОКА>>" ~border_width:2 () in
(*    window#show ();*)
    ignore (window#connect#destroy ~callback:GMain.Main.quit);
(*    let table = GPack.table ~rows:3 ~columns:2 ~packing:window#add () in*)
    let w = new_object window#add lock in
    window, w

let start (window, w) dir =
    w#construct dir;
    window#show ();
    Thread.create GtkThread.main ()

let show new_object dir lock =
    let all = init new_object lock in
    start all dir

;;
*)
